#! /usr/bin/perl

use strict;
use warnings;
use Errno ();
use Getopt::Long;
use Pod::Usage qw(pod2usage);
require 'syscall.ph';

our $VERSION = '0.02';

our @NEWDIRS = qw(
    etc
    run
    usr
    var/log
);
our @BINDDIRS = grep { -d "/$_" } qw(
    bin
    etc/alternatives
    etc/pki/tls/certs
    etc/pki/ca-trust
    etc/ssl/certs
    lib
    lib64
    sbin
    usr/bin
    usr/include
    usr/lib
    usr/lib64
    usr/libexec
    usr/sbin
    usr/share
    usr/src
);
our @TEMPDIRS = qw(tmp run/lock var/tmp);
our @COPYFILES = qw(
    etc/group
    etc/passwd
    etc/resolv.conf
    etc/hosts
);
our %KEEP_CAPS = map { $_ => 1 } (
    0,  # CAP_CHOWN
    1,  # CAP_DAC_OVERRIDE
    5,  # CAP_KILL
    6,  # CAP_SETGID
    7,  # CAP_SETUID
    10, # CAP_NET_BIND_SERVICE
);

my ($root, @bind, @robind, $opt_umount);

GetOptions(
    'root=s'   => \$root,
    'bind=s'   => \@bind,
    'robind=s' => \@robind,
    umount     => \$opt_umount,
    help       => sub {
        pod2usage(0);
    },
    version    => sub {
        print "$VERSION\n";
        exit(0);
    },
) or exit(1);

# cleanup $root
die "--root not specified\n"
    unless $root;
die "--root must be an absolute path\n"
    unless $root =~ m{^/}s;
$root =~ s{/$}{}gs;

if ($opt_umount) {
    die "root does not exist, cowardly refusing to umount\n"
        unless -d $root;
    open my $fh, "-|", "LANG=C mount"
        or die "failed to exec mount:$!";
    while (my $line = <$fh>) {
        if ($line =~ m{ on $root/([^ ]+)}) {
            run_cmd("umount", "$root/$1");
        }
    }
    exit 0;
}

# create directories
mkdir_p($root);
mkdir_p("$root/$_")
    for (@NEWDIRS, @TEMPDIRS);

# chmod the temporary directories
for my $dir (@TEMPDIRS) {
    chmod 01777, "$root/$dir"
        or die "failed to chmod $root/$dir:$!";
}

# copy files
for my $file (@COPYFILES) {
    run_cmd("cp", "-p", "/$file", "$root/$file")
        unless -e "$root/$file";
}

# bind the directories
for my $dir (@BINDDIRS) {
    if (-l "/$dir") {
        unless (-l "$root/$dir") {
            if ($dir =~ m{/[^/]+$}s) {
                mkdir_p("$root/$`");
            }
            my $dest = readlink("/$dir");
            defined($dest)
                or die "failed to read symlink(/$dir):$!";
            symlink($dest, "$root/$dir") == 1
                or die "failed to create symlink($root/$dir -> $dest):$!";
        }
    } else {
        mkdir_p("$root/$dir");
        if (is_empty("$root/$dir")) {
            run_cmd("mount", "--bind", "/$dir", "$root/$dir");
            run_cmd("mount", "-o", "remount,ro,bind", "$root/$dir");
        }
   }
}

# bind the custom directories
bind_custom($_, 0)
    for @bind;
bind_custom($_, 1)
    for @robind;

# create symlinks
symlink "../run/lock", "$root/var/lock";

# create devices
mkdir_p("$root/dev");
run_cmd(qw(mknod -m 666), "$root/dev/null", qw(c 1 3))
    unless -e "$root/dev/null";
run_cmd(qw(mknod -m 666), "$root/dev/zero", qw(c 1 5))
    unless -e "$root/dev/zero";
for my $f (qw(random urandom)) {
    run_cmd(qw(mknod -m 444), "$root/dev/$f", qw(c 1 9))
        unless -e "$root/dev/$f";
}

# just print the status if no args
if (! @ARGV) {
    print "jail is ready!\n";
    exit 0;
}

# chroot and exec
chroot($root)
    or die "failed to chroot to $root:$!";
chdir "/"
    or die "failed to chroot to /:$!";
drop_capabilities();
exec @ARGV;
die "failed to exec:$ARGV[0]:$!";

sub run_cmd {
    my @argv = @_;
    system(@argv) == 0
        or die "failed to exec $argv[0]:$!";
}

sub is_empty {
    my $path = shift;
    opendir my $fh, $path
        or die "failed to opendir:$path:$!";
    while (my $fn = readdir $fh) {
        return 0
            unless $fn eq '.' || $fn eq '..';
    }
    return 1;
}

sub bind_custom {
    my ($arg, $readonly) = @_;
    my ($src, $dest) = split ":", $arg, 2;
    $dest = $src
        unless defined $dest;
    die "paths of `--bind=src-path[:dest-path]` option must be absolute\n"
        unless $src =~ m{^/}s && $dest =~ m{^/}s;
    $dest =~ s{^/}{}s;
    if (is_empty("$src")) {
        run_cmd("touch", "$src/.jailing.keep");
    }
    mkdir_p("$root/$dest");
    if (is_empty("$root/$dest")) {
        run_cmd("mount", "--bind", "$src", "$root/$dest");
        run_cmd("mount", "-o", "remount,ro,bind", "$root/$dest")
            if $readonly;
    }
}

sub drop_capabilities {
    my $i;
    for ($i = 0; ; ++$i) {
       if (! $KEEP_CAPS{$i}) {
           # test if capability exists
           last if syscall(&SYS_prctl, 23, $i) < 0;
           if (syscall(&SYS_prctl, 24, $i) < 0) {
               warn "failed to drop capability:$i";
           }
       }
    }
    # we should at least succeed in dropping _some_ capabilities
    die "failed to drop capabilities:$!"
        if $i == 0;
}

sub mkdir_p {
    my $path = shift;
    return if -e $path;
    my $base = $path;
    $base =~ s{/[^/]+$}{}s;
    mkdir_p($base)
        if ! -e $base;
    mkdir $path
        or die "failed to create directory:$path:$!";
}

__END__

=head1 NAME

jailing - a minimalistic chroot jail builder/runner for Linux

=head1 SYNOPSIS

  # create and/or enter the jail, and optionally run the command
  jailing --root=/path/to/chroot/jail [cmd ...]

  # unmount the bind mounts of the jail
  jailing --root=/path/to/chroot/jail --umount

=head1 DESCRIPTION

The command creates a chroot jail if it does not exist, and runs the given commands within the jail.

The system directories are remounted read-only (via `mount --bind` and `mount -o remount,ro`) to minimalize the setup time and disk usage.  Other directories are created automatically.

=head1 OPTIONS

=head2 --root=path

mandatory argument specifying the root of the chroot jail.
The directory is automatically created if it does not exist.

=head2 --bind src-path[:dest-path]

=head2 --robind src-path[:dest-path]

mounts src-path of host to dest-path of the jail.
Both paths should be specified in absolute form (i.e. start with C</>).
If dest-path is omitted, then it would be mounted at C<src-path> in the jail.

C<--bind> mounts the path in read-write mode.  C<--robind> mounts as read-only.

=head2 --umount

unmounts the bound mount points for the jail

=head1 AUTHOR

Kazuho Oku

=head1 LICENSE

MIT

